home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#42 (Mar 89)
/
XCMD CODE
/
XCMDADSP.inc
< prev
Wrap
Text File
|
1989-01-11
|
13KB
|
554 lines
(********************************)
(* file: XCmdGlue.Inc *)
(* *)
(* Support routines for ADSP *)
(* Hypercard interface. *)
(* ---------------------------- *)
(* By: Donald Koscheka *)
(* Date: 9-Jan-89 *)
(* All Rights Reserved *)
(* *)
(* ---------------------------- *)
(********************************)
{**************************************}
{* *}
{* Miscellaneous support routines *}
{* *}
{**************************************}
FUNCTION RetrieveData( containerName : Str255 ): LongInt;
{***************************
* Given the name of a Hypercard
* global container, return the
* data stored there as a long
* Integer.
*
* Container data is a handle
* to the contents of a global
* container. Theses contents
* should contain the string
* representation of a long integer
* which we convert to pascal
* longInt.
*
* Since containerData is a
* copy of the data, we must
* dispose of it afterwards.
***************************}
VAR
containerData : Handle;
longStr : Str255;
BEGIN
ContainerData := GetGlobal( containerName );
{***If the container is not empty, convert it ***}
IF (ContainerData <> NIL) AND (ContainerData^ <> NIL) THEN
BEGIN
HLock( ContainerData );
ZeroToPas( ContainerData^, longStr );
RetrieveData := StrToLong( longStr );
HUnlock( ContainerData );
DisposHandle( ContainerData );
END;
END;
FUNCTION StringToShort( str : Ptr ): INTEGER;
{************************
* Given a pointer to a "C"
* string, convert the number
* to an integer and return
* it to the caller
************************}
VAR
tempStr : Str255;
BEGIN
ZeroToPas( str, tempStr );
StringToShort := Integer(StrToNum(tempStr));
END;
Function StrCmp( s1, s2 : String ): Boolean;
{***********************
* Given two strings, return true
* if they match exactly, false
* otherwise
***********************}
VAR
i,j : Integer;
matching : Boolean;
BEGIN
matching := true;
i := Integer( s1[0] ); {*** the number of characters in string ***}
j := Integer( s2[0] ); {*** as well as the comparison string ***}
IF i = j THEN {*** if not same length, not same string***}
WHILE i > 0 DO
BEGIN
WHILE matching DO
IF s1[i] <> s2[i] THEN {*** strings don't match ***}
BEGIN
matching := false;
i := 0;
END;
i := i - 1;
END;
StrCmp := matching;
END;
PROCEDURE p2cStr( myPtr : Ptr );
{******************************
* Convert a pascal string to a
* 'c' string in place
******************************}
VAR
i : LongInt;
aPtr: Ptr;
BEGIN
FOR i := 0 to myPtr^ DO
BEGIN
aPtr := Pointer( ORD( myPtr ) + 1 );
myPtr^ := aPtr^;
myPtr := aPtr;
END;
myPtr := Pointer( ORD( myPtr ) - 1 );
myPtr^ := 0;
END;
PROCEDURE TrashHandle( inH : Handle );
{**********************
* Unlock the input handle
* and deallocate it
**********************}
BEGIN
IF inH <> NIL THEN
BEGIN
HUnlock( inH );
DisposHandle( inH );
END;
END;
{**************************************}
{* *}
{* Routines to access entities in the *}
{* names table *}
{* *}
{**************************************}
FUNCTION NBPGetAddress( name : Ptr ): AddrBlock;
{****************************
* Given the name of an entity
* walk through the names table
* for the name and return
* the address if found, NIL
* otherwise
*
****************************}
VAR
error : Integer;
nbp : NBPPtr;
found : Boolean;
eName : EntityName;
eAddr : AddrBlock;
who : Integer;
str : StringPtr;
pName : Str255;
BEGIN
found := FALSE;
who := 1;
nbp := NBPPtr( RetrieveData( 'GLOBALNBPDATA' ) );
IF ( nbp <> NIL ) AND (nbp^.LookUpBuffer <> NIL) THEN
BEGIN
str := StringPtr( @eName.objStr );
ZeroToPas( name, pName );
NBPGetAddress.aNet := 0;
NBPGetAddress.aNode := 0;
NBPGetAddress.aSocket := 0;
HLock( Handle(nbp^.LookUpBuffer) );
IF (nbp^.EntCount > 0) THEN
REPEAT
error := NBPExtract( Ptr(nbp^.LookUpBuffer^),
nbp^.EntCount,who,eName,eAddr);
IF error = noErr THEN
BEGIN
found := StringEqual( str^, pName );
IF found THEN
NBPGetAddress := eAddr
ELSE
who := who + 1;
IF (who > nbp^.EntCount) THEN found := TRUE;
END
ELSE
found := TRUE;
UNTIL found;
HUnlock( Handle(nbp^.LookUpBuffer) );
END;
END;
FUNCTION NBPGetName( addr : AddrBlock ) : Handle;
{***************************
* Given the address of an entity,
* walk through the names table
* searching for the address and
* return the name of the entity,
* nil if not
*
****************************}
VAR
error : Integer;
nbp : NBPPtr;
done : Boolean;
eName : EntityName;
eAddr : AddrBlock;
who : Integer;
yourName: Handle;
BEGIN
done := FALSE;
who := 1;
yourName:= NIL;
nbp := NBPPtr( RetrieveData( 'GLOBALNBPDATA' ) );
IF (nbp <> NIL) AND (nbp^.LookUpBuffer <> NIL) THEN
BEGIN
HLock( nbp^.LookUpBuffer );
IF (nbp^.EntCount > 0) THEN
REPEAT
error := NBPExtract( nbp^.LookUpBuffer^,nbp^.EntCount,who,eName,eAddr);
IF error = noErr THEN
BEGIN
IF LongInt(addr) = LongInt(eAddr) THEN
yourName := PasToZero( eName.objStr )
ELSE
who := who + 1;
IF (who > nbp^.EntCount) THEN
done := TRUE;
END
ELSE
done := TRUE;
UNTIL (done) OR (yourName <> NIL );
HUnlock( nbp^.LookUpBuffer );
END;
NBPGetName := yourName;
END;
{**************************************}
{* *}
{* Routines to hangup and tear down a *}
{* connection *}
{* *}
{**************************************}
PROCEDURE DSPKillData( cb : cbPtr );
(****************************************)
(* Either we could not allocate enough *)
(* memory or the connection would not *)
(* initialize, dump all allocated data *)
(* *)
(* The input parameter, cb, points to *)
(* the block that we want to kill *)
(* *)
(****************************************)
BEGIN
IF cb <> NIL THEN
WITH cb^ DO
BEGIN
{*** could not allocate or initialize ***}
IF sendQ <> NIL THEN DisposPtr( sendQ );
IF recvQ <> NIL THEN DisposPtr( recvQ );
IF attn <> NIL THEN DisposPtr( attn );
TrashHandle( remName );
TrashHandle( msg );
TrashHandle( inBuf );
TrashHandle( outBuf );
TrashHandle( attnBuf );
DisposPtr( Ptr( cb ) );
END;
END;
PROCEDURE DSPDisConnect( cn : CBPtr );
{***************************
* Tear down an ADSP connection,
* deallocate the memory and remove
* the entity from the connection list.
***************************}
VAR
nb, lb : CBPtr;
dpb : dspParamBlock;
tH : Handle;
BEGIN
IF cn <> NIL THEN
BEGIN
IF cn^.remName <> NIL THEN
BEGIN
SetGlobal( 'ADSPCaller', cn^.remName );
SendCardMessage( 'HungUp');
END;
{*** remove connection from connection list ***}
IF cn = adsp^.ends THEN {*** special case: cn = first ***}
BEGIN
adsp^.ends := cn^.next;
nb := cn^.next;
IF nb <> NIL THEN nb^.last := NIL;
END
ELSE
BEGIN
nb := cn^.next;
lb := cn^.last;
IF nb <> NIL THEN nb^.last := lb;
IF lb <> NIL THEN lb^.next := nb;
END;
DSPKillData( cn );
END;
END;
FUNCTION DSPHangUp( cn : CBPtr ):OSErr;
{***********************************
* Hangup the line on requested
* connection end
*
* ----------------------------------
* IN:
* pointer to the connection's block
* handle to the data to send
*
***********************************}
VAR
myPB : DSPParamBlock;
BEGIN
IF cn <> NIL THEN {*** If the connection exists, tear it down ***}
BEGIN
WITH myPB DO
BEGIN
ioCRefNum := adsp^.dspRefNum;
ccbRefNum := cn^.ccbRef;
csCode := dspRemove;
abort := -1;
{*** Hangup synchronously because the state of the
connection is about to go ballistic ***}
END;
DSPHangup := PBControl( @myPB, SYNC );
DSPDisConnect( cn );
END;
END;
{**************************************}
{* *}
{* Routines to install a connection *}
{* and call a remote party. *}
{* *}
{**************************************}
PROCEDURE DSPAddConnection( cb : CBPtr );
{***************************
* If we have a good connection, we can
* go ahead and put it into the connection
* list. It is either the first item in
* the list or we append it to the end by
* traversing the list to find the last item
****************************}
VAR
nb, lb : CBPtr;
BEGIN
nb := adsp^.ends;
IF cb <> NIL THEN
IF nb = NIL THEN
adsp^.ends := cb
ELSE
BEGIN
WHILE nb <> NIL DO {*** walk to the end of the list ***}
BEGIN
lb := nb;
nb := nb^.next;
END;
lb^.next := cb;
cb^.next := NIL;
cb^.last := lb;
END;
END;
FUNCTION DSPCreate( addr:AddrBlock;
inBufSiz,
outBufSiz,
retry,
interval :Integer;
message : Handle ): CBPtr;
{******************************
* Creates an ADSP connection,
* adds it to the connection list,
*
* -----------------------------
* IN:
* addr : address of the entity
* inBufSiz,
* outBufSiz
* : size of the buffers
* retry : number of times to
* retry the open
* interval : 10Xticks time to wait
* between retries
* mess : callback message
* -----------------------------
* OUT:
* CBPtr : return a pointer to
* the connection, NIL if
* connection not inited
*
***********************************}
VAR
error : Integer;
siz : LongInt;
cb : CBPtr;
nbp : NBPPtr;
haveIt : BOOLEAN;
BEGIN
cb := CBPtr( NewPtr( SizeOf( Connection ) ));
IF cb <> NIL THEN
WITH cb^ DO {*** Allocate connection's structures ***}
BEGIN
ccbRef := 0;
msg := NIL;
last := NIL;
next := NIL;
adr := addr; {*** address of the remote end ***}
inBuf := NIL; {*** no data received yet ***}
outBuf := NIL; {*** no data sent yet ***}
attnBuf := NIL; {*** no attention message... ***}
mode := NOP; {*** connection not established ***}
sendQ := NewPtr( LongInt(outBufSiz) );
recvQ := NewPtr( LongInt(inBufSiz) );
attn := NewPtr( attnBufSize );
{*** (3) Initialize the connection end ***}
IF (sendQ<>NIL) AND (recvQ<>NIL) AND (attn<>NIL) THEN
BEGIN
IF message <> NIL THEN
BEGIN
siz := GetHandleSize( message );
msg := NewHandle( siz );
BlockMove( message^ , msg^, siz );
END;
WITH attnPB DO
BEGIN
userRoutine := NIL;
ioResult := 1; {*** mark it as busy***}
END;
ccb.userFlags := 0;
WITH dspPB DO {*** Initialize the connection end ***}
BEGIN
csCode := dspInit;
ccbPtr := @cb^.ccb;
userRoutine := NIL;
ioCRefnum := adsp^.dspRefNum;
ioCompletion:= NIL;
sendQSize := outBufSiz;
sendQueue := sendQ;
recvQueue := recvQ;
recvQSize := inBufSiz;
attnPtr := attn;
localSocket := adsp^.addr.aSocket;
END;
error := PBControl( @cb^.dspPB, SYNC );
IF error = noErr THEN {*** Add connection to list if init ok ***}
BEGIN
ccbRef := dspPB.ccbRefNum;
DSPAddConnection( cb );
END
ELSE
DSPKillData( cb );
END { IF data allocated OK }
ELSE{ data did not allocate or connection did not initialize }
DSPKillData( cb );
END;
DSPCreate := cb;
END;
{**************************************}
{* *}
{* Routines to send information over *}
{* the wire. *}
{* *}
{**************************************}
FUNCTION DSPTalk( cn : CBPtr; bufH : Handle ):OSErr;
{********************************
* Send the data to the requested
* connection end
*
*
* IN: pointer to the connection's block
* handle to the data to send
*
********************************}
VAR
Hsiz : LongInt;
BEGIN
{*** (1) Copy the data into a local buffer ***}
cn^.outBuf := NIL; {*** assume we won't allocate the handle ***}
IF bufH <> NIL THEN
BEGIN
HSiz := GetHandleSize( bufH );
cn^.outBuf := NewHandle( HSiz );
END;
IF cn^.outBuf <> NIL THEN
BEGIN
MoveHHi( cn^.outBuf );
HLock( cn^.outBuf );
BlockMove( bufH^, cn^.outBuf^, HSiz );
{*** (2) Send the data to the other end ***}
WITH cn^.dspPB DO
BEGIN
ioCompletion:= NIL;
ioCRefNum := adsp^.dspRefNum;
csCode := dspWrite;
ccbRefNum := cn^.ccbRef;
reqCount := Integer( HSiz );
dataPtr := cn^.outBuf^;
eom := 1;
flush := 1;
END;
DSPTalk := PBControl( @cn^.dspPB, ASYNC );
END;
END;
